home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / basic / pbc_bas.exe / DCALENDA.BAS < prev    next >
Encoding:
BASIC Source File  |  1993-01-01  |  5.1 KB  |  127 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |        PBClone  Copyright (c) 1990-1993  Thomas G. Hanlin III        |
  4. '   |                                                                      |
  5. '   +----------------------------------------------------------------------+
  6.  
  7.    DECLARE SUB CalcAttr (BYVAL Foreground%, BYVAL Background%, Attr%)
  8.    DECLARE SUB DCal (Scrn%(), CalDate$)
  9.    DECLARE SUB DScrRest (BYVAL DSeg%, BYVAL DOfs%, BYVAL Page%, BYVAL Fast%)
  10.    DECLARE SUB DXQPrint (BYVAL DSeg%, BYVAL DOfs%, St$, BYVAL Row%, BYVAL Column%, BYVAL Attr%)
  11.    DECLARE SUB GetKey (Mouse%, ASCIICode%, ScanCode%, LeftButton%, RightButton%)
  12.    DECLARE SUB GetKbd (Ins%, Caps%, Num%, ScrollLock%)
  13.    DECLARE SUB SetKbd (BYVAL Ins%, BYVAL Caps%, BYVAL Num%, BYVAL ScrollLock%)
  14.    DECLARE SUB XQPrint (St$, BYVAL Row%, BYVAL Column%, BYVAL Attr%, BYVAL Page%, BYVAL Fast%)
  15.  
  16. SUB DCalendar (Scrn%(), CalDate$, Page%, Fast%)
  17.    L% = LBOUND(Scrn%)
  18.  
  19.    CalcAttr 12, 0, InputStrAttr%       ' input prompt
  20.    CalcAttr 14, 0, InputAttr%          ' user input
  21.    CalcAttr 11, 1, StatusTextAttr%     ' status line text
  22.    CalcAttr 0, 7, StatusKeyAttr%       ' status line keys
  23.  
  24.    St$ = CHR$(27)
  25.    DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 25, 2, StatusKeyAttr%
  26.    St$ = "Last Month"
  27.    DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 25, 4, StatusTextAttr%
  28.    St$ = CHR$(26)
  29.    DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 25, 15, StatusKeyAttr%
  30.    St$ = "Next Month"
  31.    DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 25, 17, StatusTextAttr%
  32.    St$ = CHR$(24)
  33.    DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 25, 28, StatusKeyAttr%
  34.    St$ = "Last Year"
  35.    DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 25, 30, StatusTextAttr%
  36.    St$ = CHR$(25)
  37.    DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 25, 40, StatusKeyAttr%
  38.    St$ = "Next Year"
  39.    DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 25, 42, StatusTextAttr%
  40.    St$ = "<Home>"
  41.    DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 25, 52, StatusKeyAttr%
  42.    St$ = "Enter Date"
  43.    DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 25, 59, StatusTextAttr%
  44.    St$ = "<ESC>"
  45.    DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 25, 70, StatusKeyAttr%
  46.    St$ = "Exit"
  47.    DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 25, 76, StatusTextAttr%
  48.  
  49.    IF LEN(CalDate$) >= 8 THEN
  50.       MonthNr% = CINT(VAL(CalDate$))
  51.       YearNr% = CINT(VAL(MID$(CalDate$, 7)))
  52.    ELSE
  53.       St$ = DATE$
  54.       MonthNr% = CINT(VAL(St$))
  55.       YearNr% = CINT(VAL(MID$(St$, 7)))
  56.    END IF
  57.  
  58.    IF YearNr% < 100 THEN YearNr% = YearNr% + 1900
  59.  
  60.    DO
  61.       CDate$ = RIGHT$("0" + MID$(STR$(MonthNr%), 2), 2) + "-01-"
  62.       CDate$ = CDate$ + MID$(STR$(YearNr%), 2)
  63.       DCal Scrn%(), CDate$
  64.       DScrRest VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), Page%, Fast%
  65.       GetKey 0, ASCIICode%, ScanCode%, LeftB%, RightB%
  66.       SELECT CASE ScanCode%
  67.          CASE 75
  68.             IF MonthNr% = 1 THEN
  69.                IF YearNr% > 1900 THEN
  70.                   MonthNr% = 12
  71.                   YearNr% = YearNr% - 1
  72.                END IF
  73.             ELSE
  74.                MonthNr% = MonthNr% - 1
  75.             END IF
  76.          CASE 77
  77.             IF MonthNr% = 12 THEN
  78.                MonthNr% = 1
  79.                YearNr% = YearNr% + 1
  80.             ELSE
  81.                MonthNr% = MonthNr% + 1
  82.             END IF
  83.          CASE 72
  84.             IF YearNr% > 1900 THEN YearNr% = YearNr% - 1
  85.          CASE 80
  86.             IF YearNr% < 9999 THEN YearNr% = YearNr% + 1
  87.          CASE 71
  88.             GetKbd Ins%, Caps%, Num%, Scrl%
  89.             SetKbd Ins%, Caps%, -1, Scrl%
  90.             St$ = SPACE$(80)
  91.             MID$(St$, 1) = "Date to display (MM/YY):"
  92.             CDate$ = ""
  93.             DO
  94.                XQPrint St$, 25, 1, InputStrAttr%, Page%, Fast%
  95.                XQPrint CDate$, 25, 26, InputAttr%, Page%, Fast%
  96.                SetKbd Ins%, Caps%, -1, Scrl%
  97.                DO
  98.                   ky$ = INKEY$
  99.                LOOP UNTIL LEN(ky$)
  100.                IF INSTR("0123456789/", ky$) > 0 AND LEN(CDate$) < 10 THEN
  101.                   CDate$ = CDate$ + ky$
  102.                ELSEIF (ASC(ky$) = 8 OR ASC(ky$) = 127) AND LEN(CDate$) > 0 THEN
  103.                   CDate$ = LEFT$(CDate$, LEN(CDate$) - 1)
  104.                END IF
  105.             LOOP UNTIL ASC(ky$) = 13
  106.             SetKbd Ins%, Caps%, Num%, Scrl%
  107.             tmp% = INSTR(CDate$, "/")
  108.             IF tmp% THEN
  109.                MonthNr% = CINT(VAL(CDate$))
  110.                YearNr% = CINT(VAL(MID$(CDate$, tmp + 1)))
  111.                IF MonthNr% < 1 THEN
  112.                   MonthNr% = 1
  113.                ELSEIF MonthNr% > 12 THEN
  114.                   MonthNr% = 12
  115.                END IF
  116.                IF YearNr% < 100 THEN YearNr% = YearNr% + 1900
  117.                IF YearNr% < 1900 THEN
  118.                   YearNr% = 1900
  119.                ELSEIF YearNr% > 9999 THEN
  120.                   YearNr% = 9999
  121.                END IF
  122.             END IF
  123.          CASE ELSE
  124.       END SELECT
  125.    LOOP UNTIL ASCIICode% = 27
  126. END SUB
  127.